home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr21 / spkrdsgn.zip / SPEAKER.BAS next >
BASIC Source File  |  1993-05-03  |  15KB  |  509 lines
  1. DECLARE FUNCTION ltr2cf! (ltr!)
  2. DECLARE FUNCTION ci2cf! (ci!)
  3. DECLARE SUB prtInfo (type$, resonance!, Qtc!)
  4. DECLARE SUB makeSealed ()
  5. DECLARE SUB makePorted ()
  6. DECLARE SUB makeIsobarik ()
  7. DECLARE SUB header ()
  8. DECLARE SUB enterData ()
  9. DECLARE SUB storeMenu (yn$, a$)
  10. DECLARE SUB saveData ()
  11. DECLARE SUB another (yn$)
  12. DECLARE SUB tryToFit ()
  13. DECLARE SUB sysTypeMenu ()
  14. DECLARE SUB escConfirm (YorN$)
  15. DECLARE SUB enterSearchParms ()
  16. DECLARE SUB getDataMatch (Manu$, Model$, retFlag)
  17. DECLARE SUB showData ()
  18. DECLARE SUB matchedData ()
  19. DECLARE SUB spkrDataBox ()
  20. DECLARE SUB cantFind ()
  21. DECLARE SUB entryError ()
  22. DECLARE SUB box (X1%, Y1%, X2%, Y2%)
  23. DECLARE SUB clrTop ()
  24. DECLARE SUB clrBottom ()
  25. DECLARE FUNCTION PdB! (Qtc!)
  26. DECLARE FUNCTION FxMax! (Qtc!)
  27. DECLARE FUNCTION FgMax! (FxMax!)
  28. DECLARE FUNCTION Alpha! (Qtc!, Qts!)
  29. DECLARE FUNCTION Fc! (Qtc!, Qts!, Fs!)
  30. DECLARE FUNCTION F3! (Qtc!, Fc!)
  31. DECLARE FUNCTION Vb! (Vas!, Alpha!)
  32. DECLARE FUNCTION Lv! (Dv!, Vb!, Fb!)
  33. TYPE drivParm
  34.      Manuf AS STRING * 20
  35.      Model AS STRING * 10
  36.      Size AS STRING * 10
  37.      Vas AS SINGLE
  38.      Qts AS SINGLE
  39.      Fs AS SINGLE
  40.      PwrRms AS INTEGER
  41. END TYPE
  42. TYPE enclParm
  43.      Nm AS STRING * 20
  44.      drvr AS drivParm
  45.      Vol AS SINGLE
  46.      VentDiam AS SINGLE
  47.      VentLen AS SINGLE
  48.      Cutoff AS SINGLE
  49. END TYPE
  50. COMMON SHARED drvr AS drivParm
  51. COMMON SHARED oldDrvr AS drivParm
  52. COMMON SHARED encl AS enclParm
  53. COMMON SHARED mask1 AS STRING * 8
  54. COMMON SHARED mask2 AS STRING * 6
  55. mask1 = "&##.## &"
  56. mask2 = "&### &"
  57.  
  58. ON ERROR GOTO errorHandler
  59.  
  60. header
  61. DO                                      'MAIN MENU
  62.      clrTop
  63.      clrBottom
  64.      box 8, 23, 14, 56
  65.      LOCATE 9, 25: PRINT "1. E)nter driver data"
  66.      LOCATE 10, 25: PRINT "2. G)et driver data from disk"
  67.      LOCATE 11, 25: PRINT "3. F)it to critical parameters"
  68.      LOCATE 13, 40: PRINT "<Esc>=quit"
  69.      DO
  70.           a$ = INKEY$
  71.      LOOP WHILE a$ = ""
  72.      SELECT CASE a$
  73.           CASE "1", "E", "e": enterData
  74.           CASE "2", "G", "g": enterSearchParms
  75.           CASE "3", "F", "f": tryToFit
  76.           CASE CHR$(27): escConfirm YorN$
  77.                SELECT CASE YorN$
  78.                     CASE "N", "n": a$ = ""
  79.                     CASE "Y", "y": VIEW PRINT 1 TO 23: CLS : END
  80.                END SELECT
  81.           CASE ELSE: entryError
  82.      END SELECT
  83. LOOP UNTIL a$ = CHR$(27)
  84. END
  85. errorHandler:
  86.      clrBottom
  87.      box 20, 10, 22, 70
  88.      COLOR 30
  89.      BEEP
  90.      SELECT CASE ERR
  91.           CASE 6: LOCATE 21, 12: PRINT ERR: LOCATE 21, 23: PRINT "Number too large! Re-enter please"
  92.           CASE 11: LOCATE 21, 12: PRINT ERR: LOCATE 21, 26: PRINT "Attempted division by zero!"
  93.           CASE 13: LOCATE 21, 12: PRINT ERR: LOCATE 21, 28: PRINT "Input wrong data type!"
  94.           CASE 24, 25, 27: LOCATE 21, 12: PRINT ERR: LOCATE 21, 31: PRINT "Printer not ready!"
  95.           CASE 51: LOCATE 21, 12: PRINT ERR: LOCATE 21, 28: PRINT "Qbasic system failure!!": SLEEP 2: END
  96.           CASE 53, 75, 76: LOCATE 21, 12: PRINT ERR: LOCATE 21, 29: PRINT "Cannot find data file!": SLEEP 2: END
  97.           CASE 57: LOCATE 21, 12: PRINT ERR: LOCATE 21, 27: PRINT "I/O error, unrecoverable!": SLEEP 2: END
  98.           CASE 61: LOCATE 21, 12: PRINT ERR: LOCATE 21, 35: PRINT "Disk Full!"
  99.           CASE ELSE: LOCATE 21, 12: PRINT ERR: LOCATE 21, 25: PRINT "Unknown error, unrecoverable!": SLEEP 2: END
  100.      END SELECT
  101.      COLOR 7
  102.      SLEEP 3
  103.      clrBottom
  104.      box 20, 10, 22, 70
  105.      LOCATE 21, 22: PRINT "Press any key when ready to continue"
  106.      DO
  107.           a$ = INKEY$
  108.      LOOP WHILE a$ = ""
  109.      RESUME 0
  110.  
  111. FUNCTION Alpha! (Qtc!, Qts!)
  112.         Alpha! = (Qtc! / Qts!) ^ 2 - 1
  113. END FUNCTION
  114.  
  115. SUB another (yn$)
  116.      DO
  117.           clrBottom
  118.           box 20, 32, 22, 48
  119.           LOCATE 21, 33: PRINT "Another? (Y/N)"
  120.           DO
  121.                yn$ = INKEY$
  122.           LOOP WHILE yn$ = ""
  123.           SELECT CASE yn$
  124.                CASE "y", "Y", "n", "N", CHR$(27)
  125.                CASE ELSE
  126.                     clrBottom
  127.                     box 20, 29, 22, 51
  128.                     LOCATE 21, 32: PRINT "Please select Y or N"
  129.                     SLEEP 1
  130.           END SELECT
  131.      LOOP UNTIL UCASE$(yn$) = "Y" OR UCASE$(yn$) = "N" OR yn$ = CHR$(27)
  132. END SUB
  133.  
  134. SUB box (X1%, Y1%, X2%, Y2%)       'Builds single-line box
  135.      ULC$ = CHR$(218)              '┌
  136.      URC$ = CHR$(191)              '┐
  137.      LLC$ = CHR$(192)              '└
  138.      LRC$ = CHR$(217)              '┘
  139.      VL$ = CHR$(179)               '│
  140.      HL$ = CHR$(196)               '─
  141.      LOCATE X1%, Y1%               'place a ┌ at X1,Y1
  142.      PRINT ULC$;
  143.      FOR y = (Y1% + 1) TO (Y2% - 1)'draws horizontal line with ─'s
  144.           LOCATE X1%, y
  145.           PRINT HL$;
  146.      NEXT y
  147.      PRINT URC$;                   'place a ┐ at end of line         
  148.      FOR x = (X1% + 1) TO (X2% - 1)'plots │'s downward.  Left then right
  149.           LOCATE x, Y1%
  150.           PRINT VL$;
  151.           LOCATE x, Y2%
  152.           PRINT VL$
  153.      NEXT x
  154.      LOCATE X2%, Y1%               'place a └ at X2,Y1
  155.      PRINT LLC$
  156.      FOR yy = (Y1% + 1) TO (Y2% - 1)'draw horizontal line of ─'s for bottom
  157.           LOCATE X2%, yy
  158.           PRINT HL$
  159.      NEXT yy
  160.      LOCATE X2%, Y2%               'place final ┘ at X2,Y2
  161.      PRINT LRC$
  162. END SUB
  163.  
  164. SUB cantFind
  165.      clrBottom
  166.      box 20, 29, 22, 51
  167.      COLOR 13
  168.      BEEP
  169.      LOCATE 21, 30: PRINT "Cannot locate driver"
  170.      COLOR 7
  171.      SLEEP 1
  172.      clrBottom
  173. END SUB
  174.  
  175. FUNCTION ci2cf (ci!)
  176.      ci2cf = ci! / 1728
  177. END FUNCTION
  178.  
  179. SUB clrBottom
  180.      VIEW PRINT 20 TO 23
  181.      CLS
  182.      VIEW PRINT 4 TO 23
  183. END SUB
  184.  
  185. SUB clrTop
  186.      VIEW PRINT 4 TO 19
  187.      CLS
  188.      VIEW PRINT 4 TO 23
  189. END SUB
  190.  
  191. SUB enterData
  192.      DO
  193.      CLS
  194.      spkrDataBox
  195.           LOCATE 15, 24: PRINT "Press <Enter> for all to exit"
  196.           LOCATE 7, 36, , 3, 10: INPUT "", drvr.Manuf
  197.           LOCATE 8, 36: INPUT "", drvr.Model
  198.           LOCATE 9, 36: INPUT "", drvr.Size
  199.           LOCATE 10, 36: INPUT "", drvr.Vas
  200.           LOCATE 11, 36: INPUT "", drvr.Qts
  201.           LOCATE 12, 36: INPUT "", drvr.Fs
  202.           LOCATE 13, 36: INPUT "", drvr.PwrRms
  203.           LOCATE , , 0
  204.           IF drvr.Qts = 0 AND drvr.Fs = 0 AND drvr.Vas = 0 THEN EXIT DO
  205.           storeMenu yn$, a$
  206.      LOOP UNTIL yn$ = "n" OR yn$ = "N" OR yn$ = CHR$(27) OR a$ = CHR$(27)
  207. END SUB
  208.  
  209. SUB enterSearchParms
  210.      CLS
  211.      box 9, 25, 12, 55
  212.      LOCATE 10, 26: PRINT "Manuf :"
  213.      LOCATE 11, 26: PRINT "Model :"
  214.      LOCATE 10, 34: INPUT "", Manu$
  215.      LOCATE 11, 34: INPUT "", Model$
  216.      IF Manu$ = "" AND Model$ = "" THEN EXIT SUB
  217.      getDataMatch Manu$, Model$, flag
  218.      SELECT CASE flag
  219.           CASE 1
  220.                showData
  221.           CASE ELSE
  222.                cantFind
  223.      END SELECT
  224. END SUB
  225.  
  226. SUB entryError
  227.      clrBottom
  228.      box 20, 33, 22, 45
  229.      LOCATE 21, 34
  230.      COLOR 13
  231.      PRINT "Entry error"
  232.      COLOR 7
  233.      BEEP
  234.      FOR x = 1 TO 300: NEXT x
  235. END SUB
  236.  
  237. SUB escConfirm (YorN$)
  238.      box 20, 28, 22, 51
  239.      COLOR 13
  240.      LOCATE 21, 30: PRINT "Are you sure?  (Y/N)"
  241.      COLOR 7
  242.      DO
  243.           YorN$ = INKEY$
  244.      LOOP UNTIL (YorN$ <> "")
  245.      LOCATE 21, 55: PRINT YorN$
  246.      SLEEP 1
  247.      LOCATE 21, 55: PRINT " "
  248.      IF YorN$ <> "Y" AND YorN$ <> "y" AND YorN$ <> "N" AND YorN$ <> "n" THEN
  249.           BEEP
  250.           COLOR 30
  251.           LOCATE 21, 30: PRINT "Select Y or N please"
  252.           COLOR 7
  253.           SLEEP 1
  254.           escConfirm YorN$
  255.      END IF
  256. END SUB
  257.  
  258. FUNCTION F3! (Qtc!, Fc!)
  259.      F3! = ((ABS((((1 / (Qtc! ^ 2)) - 2) + (((((1 / (Qtc! ^ 2)) - 2) ^ 2) + 4) ^ .5)) / 2)) ^ .5) * Fc!
  260.  
  261. END FUNCTION
  262.  
  263. FUNCTION Fc! (Qtc!, Qts!, Fs!)
  264.      Fc! = (Qtc! * Fs!) / Qts!
  265. END FUNCTION
  266.  
  267. FUNCTION FgMax! (FxMax!)
  268.      FgMax! = 1 / FxMax!
  269. END FUNCTION
  270.  
  271. FUNCTION FxMax! (Qtc!)
  272.      FxMax! = (1 - (1 / (2 * (Qtc! ^ 2)))) ^ .5
  273. END FUNCTION
  274.  
  275. SUB getDataMatch (Manu$, Model$, retFlag)
  276.      OPEN "c:\SPEAKER.DAT" FOR RANDOM AS 1 LEN = LEN(drvr)
  277.           SEEK 1, 1
  278.           DO
  279.                GET 1, , drvr
  280.           LOOP UNTIL (UCASE$(Manu$) = RTRIM$(UCASE$(drvr.Manuf)) AND UCASE$(Model$) = RTRIM$(UCASE$(drvr.Model))) OR (EOF(1))
  281.           IF (EOF(1)) THEN
  282.                     retFlag = 0
  283.                ELSE
  284.                     retFlag = 1
  285.           END IF
  286.      CLOSE 1
  287. END SUB
  288.  
  289. SUB header                         'Title Header
  290.      CLS
  291.      LOCATE , 26: PRINT "Bass enclosure design program"
  292.      LOCATE , 22: PRINT "Written by Terry Christopherson, 5/92"
  293.      FOR x = 1 TO 80
  294.           PRINT CHR$(196);
  295.      NEXT x
  296.      VIEW PRINT 4 TO 23
  297. END SUB
  298.  
  299. FUNCTION ltr2cf (ltr!)
  300.      ltr2cf = ltr! * .0353
  301. END FUNCTION
  302.  
  303. FUNCTION Lv! (Dv!, Vb!, Fb!)
  304.      Lv! = ((1.463 * (10 ^ 7) * ((Dv! / 2) ^ 2)) / ((Fb! ^ 2) * (Vb! ^ 2))) - (1.436 * (Dv! / 2))
  305. END FUNCTION
  306.  
  307. SUB makeIsobarik
  308.      CLS
  309.      LOCATE 12, 35: PRINT "Making Isobarik"
  310.      SLEEP 2
  311. END SUB
  312.  
  313. SUB makePorted
  314.      CLS
  315.      LOCATE 12, 35: PRINT "Making Ported"
  316.      SLEEP 2
  317. END SUB
  318.  
  319. SUB makeSealed
  320.      SHARED resonance AS SINGLE
  321.      clrTop
  322.      box 8, 15, 12, 64
  323.      LOCATE 9, 16: PRINT "Input desired Qtc (.5 to 1.5) for this enclosure"
  324.      LOCATE , 17: PRINT "(.5=Overdamped - .707=Max Flat - 1.5=4dB peak)"
  325.      LOCATE , 38: INPUT "", Qtc!
  326.      clrBottom
  327.      box 20, 34, 22, 46
  328.      COLOR 19
  329.      LOCATE 21, 35: PRINT "Calculating"
  330.      SLEEP 2
  331.      COLOR 7
  332.      encl.Vol = drvr.Vas / Alpha!(Qtc!, drvr.Qts)
  333.      resonance! = Fc!(Qtc!, drvr.Qts, drvr.Fs)
  334.      encl.Cutoff = F3!(Qtc!, resonance!)
  335.      CLS
  336.      box 10, 23, 14, 57
  337.      LOCATE 11, 27: PRINT USING mask1; "Enclosure Volume -"; encl.Vol; "Cu Ft"
  338.      LOCATE , 24: PRINT USING mask2; "Enclosure Resonance -"; resonance; "Hz"
  339.      LOCATE , 32: PRINT USING mask2; "-3dB Cutoff -"; encl.Cutoff; "Hz"
  340.      clrBottom
  341.      box 20, 27, 22, 52
  342.      LOCATE 21, 28: PRINT "Print information? (Y/N)"
  343.      DO
  344.           a$ = INKEY$
  345.      LOOP WHILE a$ = ""
  346.      SELECT CASE a$
  347.           CASE "y", "Y": prtInfo "s", resonance!, Qtc!
  348.           CASE "n", "N"
  349.                clrBottom
  350.                box 20, 27, 22, 53
  351.                LOCATE 21, 28: PRINT "Press any key to continue"
  352.                DO
  353.                     b$ = INKEY$
  354.                LOOP WHILE b$ = ""
  355.           CASE ELSE: entryError
  356.      END SELECT
  357. END SUB
  358.  
  359. SUB matchedData
  360.      clrBottom
  361.      box 20, 26, 22, 54
  362.      COLOR 27
  363.      BEEP
  364.      LOCATE 21, 27: PRINT "Matches driver in database!"
  365.      COLOR 7
  366.      SLEEP 2
  367.      clrBottom
  368. END SUB
  369.  
  370. FUNCTION PdB! (Qtc!)
  371.      PdB! = 1.30103 * ((Qtc ^ 4) / ((Qtc ^ 2) - .25)) ^ .5
  372. END FUNCTION
  373.  
  374. SUB prtInfo (type$, resonance!, Qtc!)
  375.      clrBottom
  376.      box 20, 22, 22, 58
  377.      LOCATE 21, 23: PRINT "Press any key when printer is ready"
  378.      DO
  379.           a$ = INKEY$
  380.      LOOP WHILE a$ = ""
  381.      LPRINT : LPRINT "  Driver: ", drvr.Manuf, drvr.Model
  382.      LPRINT USING mask1; "  Vas:"; drvr.Vas; "Cu Ft"
  383.      LPRINT USING mask1; "  Qts:"; drvr.Qts
  384.      LPRINT USING mask2; "   Fs:"; drvr.Fs; "Hz"
  385.      LPRINT : LPRINT "  Using"; Qtc!; "Qtc"
  386.      LPRINT : LPRINT USING mask1; "       Enclosure Volume -"; encl.Vol; "Cu Ft"
  387.      LPRINT USING mask2; "      Resonant Freqency -"; resonance!; "Hz"
  388.      LPRINT USING mask2; "  -3dB Cutoff Frequency -"; encl.Cutoff; "Hz"
  389.      LPRINT CHR$(10)
  390. END SUB
  391.  
  392. SUB saveData
  393.      OPEN "c:\SPEAKER.DAT" FOR RANDOM AS #1 LEN = LEN(drvr)
  394.      DO
  395.           GET #1, , oldDrvr
  396.      LOOP UNTIL (oldDrvr.Manuf = drvr.Manuf AND oldDrvr.Model = drvr.Model) OR (EOF(1))
  397.      IF (EOF(1)) THEN
  398.           PUT #1, , drvr
  399.           CLOSE #1
  400.           another YorN$
  401.      ELSE matchedData
  402.      END IF
  403. END SUB
  404.  
  405. SUB showData
  406.           CLS
  407.           spkrDataBox
  408.           LOCATE 7, 36: PRINT drvr.Manuf
  409.           LOCATE 8, 36: PRINT drvr.Model
  410.           LOCATE 9, 36: PRINT drvr.Size
  411.           LOCATE 10, 36: PRINT drvr.Vas
  412.           LOCATE 11, 36: PRINT drvr.Qts
  413.           LOCATE 12, 36: PRINT drvr.Fs
  414.           LOCATE 13, 36: PRINT drvr.PwrRms
  415.      DO
  416.           clrBottom
  417.           box 20, 27, 22, 52
  418.           LOCATE 21, 28: PRINT "Use this speaker? (Y/N)"
  419.           DO
  420.                a$ = INKEY$
  421.           LOOP WHILE a$ = ""
  422.           SELECT CASE a$
  423.                CASE "y", "Y": sysTypeMenu
  424.                CASE "n", "N": enterSearchParms
  425.                CASE CHR$(27)
  426.                CASE ELSE: entryError
  427.           END SELECT
  428.      LOOP UNTIL UCASE$(a$) = "Y" OR UCASE$(a$) = "N" OR a$ = CHR$(27)
  429. END SUB
  430.  
  431. SUB spkrDataBox
  432.           box 6, 20, 16, 60
  433.           LOCATE 7, 22: PRINT "Manufacturer:  ";
  434.           LOCATE 8, 22: PRINT "       Model:  ";
  435.           LOCATE 9, 22: PRINT "        Size:  ";
  436.           LOCATE 10, 22: PRINT "         Vas:  ";
  437.           LOCATE 10, 43: PRINT "Cu.Ft.";
  438.           LOCATE 11, 22: PRINT "         Qts:  ";
  439.           LOCATE 12, 22: PRINT "          Fs:  ";
  440.           LOCATE 13, 22: PRINT "   RMS Power:  ";
  441. END SUB
  442.  
  443. SUB storeMenu (yn$, a$)
  444.      del$ = CHR$(0) + CHR$(83)
  445.      DO
  446.           CLS
  447.           box 8, 20, 15, 60
  448.           LOCATE 9, 24: PRINT "1. S)ave driver to disk"
  449.           LOCATE 10, 24: PRINT "2. U)se driver and save to disk"
  450.           LOCATE 11, 24: PRINT "3. N)O save but use driver"
  451.           LOCATE 13, 22: PRINT "<Delete> Erase driver, re-enter data"
  452.           LOCATE 14, 22: PRINT "<Esc> Cancel, back"
  453.                Manu$ = drvr.Manuf
  454.                Model$ = drvr.Model
  455.                DO
  456.                     a$ = INKEY$
  457.                LOOP WHILE a$ = ""
  458.                SELECT CASE a$
  459.                     CASE "1", "s", "S"
  460.                          saveData
  461.                          another yn$
  462.                          IF UCASE$(yn$) = "N" THEN : CLS : END
  463.                     CASE "2", "u", "U"
  464.                          saveData
  465.                          sysTypeMenu
  466.                          another yn$
  467.                          IF UCASE$(yn$) = "N" THEN : CLS : END
  468.                     CASE "3", "n", "N"
  469.                          sysTypeMenu
  470.                          another yn$
  471.                          IF UCASE$(yn$) = "N" THEN : CLS : END
  472.                     CASE CHR$(27)
  473.                     CASE del$
  474.                     CASE ELSE: entryError
  475.                END SELECT
  476.      LOOP UNTIL a$ = "1" OR a$ = "2" OR a$ = "3" OR a$ = CHR$(27) OR a$ = del$ OR yn$ = "Y" OR yn$ = "y"
  477. END SUB
  478.  
  479. SUB sysTypeMenu
  480.      DO
  481.           CLS
  482.           box 9, 29, 15, 50
  483.           LOCATE 10, 30: PRINT "1. S)ealed System"
  484.           LOCATE , 30: PRINT "2. V)ented System"
  485.           LOCATE , 30: PRINT "3. I)sobarik System"
  486.           LOCATE 14, 32: PRINT "<Esc> to cancel"
  487.           DO
  488.                a$ = INKEY$
  489.           LOOP WHILE a$ = ""
  490.           SELECT CASE a$
  491.                CASE "1", "S", "s": makeSealed
  492.                CASE "2", "V", "v": makePorted
  493.                CASE "3", "I", "i": makeIsobarik
  494.                CASE CHR$(27)
  495.                CASE ELSE: entryError
  496.           END SELECT
  497.      LOOP UNTIL a$ = CHR$(27)
  498. END SUB
  499.  
  500. SUB tryToFit
  501.      CLS
  502.      PRINT "Try to fit"
  503. END SUB
  504.  
  505. FUNCTION Vb! (Vas!, Alpha!)
  506.      Vb! = Vas! / Alpha!
  507. END FUNCTION
  508.  
  509.